home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
spacei_1
/
spinvdrs.bas
< prev
Wrap
BASIC Source File
|
1999-01-27
|
2KB
|
69 lines
Attribute VB_Name = "Module1"
Private Type playerRecord
name As String
score As Long
End Type
Public players(3) As playerRecord ' public because we've got proc in other modules
'my detectcollision function
Public Function detectcol(obj1, obj2 As Object) As Boolean
Dim obj1cx, obj1cy, obj2cx, obj2cy, obj2Left, obj2Top As Long
obj1cx = obj1.Left + (obj1.Width / 2) 'centre of obj1
obj1cy = obj1.Top + (obj1.Height / 2)
obj2cx = obj2.Left + (obj2.Width / 2) 'centre of obj1
obj2cy = obj2.Top + (obj2.Height / 2)
detectcol = False 'assume false return value
'algorithm from 'the black art of visual basic programming'
'check if centers of objects are further from each other than their widths
If Abs(obj1cx - obj2cx) < ((obj1.Width + obj2.Width) / 2) Then
If Abs(obj1cy - obj2cy) < ((obj1.Height + obj2.Height) / 2) Then
detectcol = True
Beep
End If
End If
'top left corner
'If obj2.Left >= obj1.Left And obj2.Left <= obj1.Left + obj1.Width _
'And obj2.Top >= obj1.Top And obj2.Top <= obj1.Top + obj1.Height _
'Then
' detectcol = True
' Beep
' Exit Function
'End If
'topright corner
'If obj2.Left + obj2.Width >= obj1.Left And obj2.Left + obj2.Width <= obj1.Left + obj1.Width _
'And obj2.Top >= obj1.Top And obj2Top <= obj1.Top + obj1.Height _
'Then
' detectcol = True
'End If
'bottom right corner
'If obj2.Left + obj2.Width >= obj1.Left And obj2.Left + obj2.Width <= obj1.Left + obj1.Width _
'And obj2.Top + obj2.Height >= obj1.Top And obj2.Top + obj2.Height <= obj1.Top + obj1.Height _
'Then
' detectcol = True
' Beep
' Exit Function
'End If
'bottom left corner
'If obj2.Left >= obj1.Left And obj2.Left <= obj1.Left + obj1.Width _
'And obj2.Top + obj2.Height >= obj1.Top And obj2Top + obj2.Height <= obj1.Top + obj1.Height _
'Then
' detectcol = True
'End If
'centre of obj 1 compared
'If obj1cx >= obj2.Left And obj1cx <= obj2.Left + obj2.Width _
'And obj1cy >= obj2.Top And obj1cy <= obj2.Top + obj2.Height _
'Then
' detectcol = True
' Beep
' End If
'these other functions(by me) used to test corners of one obj to see if
' they were in other obj---I also used center of one obj in some tests
End Function